home *** CD-ROM | disk | FTP | other *** search
Text File | 1993-08-30 | 58.2 KB | 1,535 lines |
- SAS PROGRAM
-
- REJECT_KEY EQUATE(CTRL_ESC)
- ACCEPT_KEY EQUATE(CTRL_ENTER)
- TRUE EQUATE(1)
- FALSE EQUATE(0)
-
- !---------------- Eckenroed & Associates 07-90 -----------------------
- !
- ! This model has been modified for the REPORT3 LEM. Make sure
- ! you have the following .BIN files in the current directory:
- ! - INT.BIN
- ! - REPORT3.BIN
- !
- ! All changes have been marked with '####'.
- !
- !---------------------------------------------------------------------
- MAP
- PROC(G_OPENFILES)
- MODULE('SAS001')
- PROC(MAIN_MENU) !* T H E M A I N M E N U *
- .
- MODULE('SAS002')
- PROC(VIEW_INV) !Inventory Directory Table
- .
- MODULE('SAS003')
- PROC(UPDATE_ITEMS) !Add Items To An Order
- .
- MODULE('SAS004')
- PROC(ORDER_ENTRY) !Order Entry
- .
- MODULE('SAS005')
- PROC(EDIT_PRICE) !Procedure To Edit Order Price
- .
- MODULE('SAS006')
- PROC(VIEW_CLI) !View Client Table
- .
- MODULE('SAS007')
- PROC(ADD_ORDERS) !Add a New Order
- .
- MODULE('SAS008')
- PROC(PRINT_ORDER) !Print Current Order (Invoice)
- .
- MODULE('SAS009')
- PROC(VIEW_ORDS) !View Current Orders
- .
- MODULE('SAS010')
- PROC(MENU_UTILS) !Menu Utilities
- .
- MODULE('SAS011')
- PROC(PICK_VENDORS) !Pick a Vendor
- .
- MODULE('SAS012')
- PROC(REPORT_MENU) !Report Generation Menu
- .
- MODULE('SAS013')
- PROC(PRINT_CLIENT) !Print the Client List
- .
- MODULE('SAS014')
- PROC(PRINT_CLASS1) !Print Price List (Class 1)
- .
- MODULE('SAS015')
- PROC(PRINT_CLASS2) !Print Price List (Class 2)
- .
- MODULE('SAS016')
- PROC(PRINT_INVNTY) !Print Entire Inventory
- .
- MODULE('SAS017')
- PROC(PRINT_VENDOR) !Print Vendor List
- .
- MODULE('SAS018')
- PROC(PRINT_TICKET) !Print Order Ticket
- .
- MODULE('SAS019')
- PROC(VIEW_METHODS) !View Payment Methods
- .
- MODULE('SAS020')
- PROC(EDIT_METHODS) !Edit Payment Methods
- .
- MODULE('SAS021')
- PROC(VIEW_TERMS) !View Payment Terms
- .
- MODULE('SAS022')
- PROC(EDIT_TERMS) !Edit Payment Terms
- .
- MODULE('SAS023')
- PROC(VIEW_VENDORS) !View Vendor List
- .
- MODULE('SAS024')
- PROC(UPD_CLI) !Update Client Information
- .
- MODULE('SAS025')
- PROC(SHOW_COST) !Show Cost and Profit
- .
- MODULE('SAS026')
- PROC(UPD_COMPANY) !Update Company Information
- .
- MODULE('SAS027')
- PROC(VIEW_COMENTS) !View Comments
- .
- MODULE('SAS028')
- PROC(PICK_ITEM) !Current Items Table
- .
- MODULE('SAS029')
- PROC(GET_DETAIL) !Get Final Order Detail
- .
- MODULE('SAS030')
- PROC(EDIT_VENDORS) !Edit Vendors
- .
- MODULE('SAS031')
- PROC(LIST_CLI) !List Clients
- .
- MODULE('SAS032')
- PROC(PRINT_CLASS3) !Print Price List (Class 3)
- .
- MODULE('SAS033')
- PROC(UPD_INV) !Inventory Update Form
- .
- MODULE('SAS034')
- PROC(VIEW_CLI_VEN)
- .
- MODULE('SAS035')
- PROC(VIEW_VEN_NUM) !View Vendor List
- .
- MODULE('SAS036')
- PROC(VIEW_NOTES) !View Notes
- .
- MODULE('SAS037')
- PROC(PRINT_ORDERE) !Print Current Order (Invoice)
- .
- MODULE('SAS038')
- PROC(PRINT_TICKEE) !Print Order Ticket
- .
- MODULE('SAS039')
- PROC(CLIENT_LAB) !Client Mailing Labels
- .
- MODULE('SAS040')
- PROC(VIEW_QUANT)
- .
- MODULE('SAS041')
- PROC(UPD_QUANTITY)
- .
- MODULE('SAS042')
- PROC(PAST_INVOICE) !Past Invoice Table
- .
- MODULE('SAS043')
- PROC(VIEW_PAST) !View Past Orders
- .
- MODULE('SAS044')
- PROC(SHOW_DETAIL) !Show Final Order Detail
- .
- MODULE('SAS045')
- PROC(INVENTORY) !Inventory Quantity Updates
- .
- MODULE('SAS046')
- PROC(UPD_QUANT)
- .
- MODULE('SAS047')
- PROC(INV_RPT_MNU) !Inventory Report Menu
- .
- MODULE('SAS048')
- PROC(SLS_RPT_MNU) !Sales Report Menu
- .
- MODULE('SAS049')
- PROC(CLI_RPT_MNU) !Client Report Menu
- .
- MODULE('SAS050')
- PROC(VEN_RPT_MNU) !Vendor Report List
- .
- MODULE('SAS051')
- PROC(LABELS) !Mail Labels Explained
- .
- MODULE('SAS052')
- PROC(VENDOR_LAB) !Vendor Mailing Labels
- .
- MODULE('SAS053')
- PROC(QUOTE_BY_SLS) !Outstanding Quotes by Salepers
- .
- MODULE('SAS054')
- PROC(VIEW_SALESP) !View Salespersons
- .
- MODULE('SAS055')
- PROC(UPD_SALESP) !Update Salespersons
- .
- MODULE('SAS056')
- PROC(SUM_Q_SALES) !Sum Sales Quotation Data
- .
- MODULE('SAS057')
- PROC(QUOTE_ALL) !Outstanding Quotes
- .
- MODULE('SAS058')
- PROC(SUM_Q_ALL) !Sum Sales Quotation Data
- .
- MODULE('SAS059')
- PROC(INV_ALL)
- .
- MODULE('SAS060')
- PROC(INV_BY_SALES)
- .
- MODULE('SAS061')
- PROC(TAX_RPT)
- .
- MODULE('SAS062')
- PROC(INV_BY_CUST)
- .
- MODULE('SAS063')
- PROC(SUM_I_CUST) !Sum Sales by Cust Data
- .
- MODULE('SAS064')
- PROC(PICK_CLI)
- .
- MODULE('SAS065')
- PROC(SUM_I_ALL) !Sum Sales Invoice Data
- .
- MODULE('SAS066')
- PROC(SUM_I_SALES) !Sum Sales Invoice Data
- .
- MODULE('SAS067')
- PROC(BELOW_MIN) !Below Minimum Report By Group
- .
- MODULE('SAS068')
- PROC(BELOW_MIN_VN) !Below Minimum Report By Vendor
- .
- MODULE('SAS069')
- PROC(VIEW_COMENT)
- .
- MODULE('SAS070')
- PROC(PAST_COST) !Show Cost and Profit
- .
- MODULE('SAS071')
- PROC(PRT_CLI_COM) !Print Client List w/Comment
- .
- MODULE('SAS072')
- PROC(PRT_VEN_COM) !Print Vendor List
- .
- MODULE('SAS073')
- PROC(INVN_VALUE) !Cost of Inventory
- .
- MODULE('SAS074')
- PROC(VIEW_GROUP) !View Inventory By Group
- .
- MODULE('SAS075')
- PROC(PICK_GROUP) !View Inventory By Group
- .
- MODULE('SAS076')
- PROC(DEL_ORDERS) !Delete Past Invoices
- .
- MODULE('SAS077')
- PROC(VIEW_PAYMENT) !View Payments
- .
- MODULE('SAS078')
- PROC(ADD_PAYMENT) !Add Payment
- .
- MODULE('SAS079')
- PROC(AR_OPEN) !View AR open Orders
- .
- MODULE('SAS080')
- PROC(NO_RECORDS)
- .
- MODULE('SAS081')
- PROC(AR_RPT_MNU) !AR Report Menu
- .
- MODULE('SAS082')
- PROC(AR_UNPAID)
- .
- MODULE('SAS083')
- PROC(CLASS1_QTY) !Price List - Class 1 w/QTY
- .
- MODULE('SAS084')
- PROC(CLASS2_QTY) !Price List - Class 2 w/QTY
- .
- MODULE('SAS085')
- PROC(CLASS3_QTY) !Price List - Class 3 w/QTY
- .
- MODULE('SAS086')
- PROC(COUNT_SHEET1) !Item Count Sheets By Part#
- .
- MODULE('SAS087')
- PROC(COUNT_SHEET2) !Item Count Sheets By Group
- .
- MODULE('SAS088')
- PROC(CATALOG) !Catalog List
- .
- MODULE('SAS089')
- PROC(CLIENT_STMNT)
- .
- MODULE('SAS090')
- PROC(PICK_CLI_FRM)
- .
- MODULE('SAS091')
- PROC(ALL_STMNT)
- .
- MODULE('SAS092')
- PROC(ABOUT_SAS) !About SAS Screen
- .
- MODULE('SAS093')
- PROC(PICK_CLIENT)
- .
- MODULE('SAS094')
- PROC(PRT_CLI_HIST) !Client Purchasing History
- .
- MODULE('SAS095')
- PROC(OPEN_SCR) !OPENING SCREEN
- .
- MODULE('SAS096')
- PROC(PRINTORDMENU) !PRINT ORDER MENU
- .
- MODULE('SAS097')
- PROC(PRINT_LABEL)
- .
- MODULE('SAS098')
- PROC(PRINT_ENVLOP)
- .
- MODULE('SAS099')
- PROC(PO_ENTRY) !Purchase Order Entry
- .
- MODULE('SAS100')
- PROC(NO_PRODUCT)
- .
- MODULE('SAS101')
- PROC(VIEW_PURCHS)
- .
- MODULE('SAS102')
- PROC(ADD_PURCH)
- .
- MODULE('SAS103')
- PROC(PO_WARN)
- .
- MODULE('SAS104')
- PROC(CLI_REP_1LN) !Client List
- .
- MODULE('SAS105')
- PROC(UPDATE_ITP) !Add Items To An PO Order
- .
- MODULE('SAS106')
- PROC(PRINT_PACK) !Print Packing List
- .
- MODULE('SAS107')
- PROC(PICK_ORD) !View Current Orders
- .
- MODULE('SAS108')
- PROC(PUR_RPT_MNU) !AR Report Menu
- .
- MODULE('SAS109')
- PROC(PUR_ORD_RPT) !Purchase Order Report
- .
- MODULE('SAS110')
- PROC(PUR_OPEN_RPT) !Summary of Open Purchase Order
- .
- MODULE('SAS111')
- PROC(PUR_BACK_RPT) !Backorder Report
- .
- MODULE('SAS112')
- PROC(LOOKUP_PO)
- .
- MODULE('SAS113')
- PROC(MAIN_SCR) !Opening Screen
- .
- MODULE('MYCODE')
- PROC(PACKDATA) !Pack Data Files
- PROC(PRINT_ORDHOW)
- PROC(PRINT_TICHOW)
- PROC(ADJUST_INV)
- PROC(MASS_UPDATE) !MASS Update
- PROC(TAX_UPDATE) !Mass Update Client Tax Rate
- PROC(ADJ_INV_PO)
- PROC(COPY_ORD) !COPY ORDER
- PROC(BACK_ORD) !MARK AS BACKORDERED ITEM
- PROC(PO_TRANS_ALL) !MOVE ALL PO ITEMS TO INVENTORY
- PROC(INV_QUOTE) !Convert Invoice back to Quote
- PROC(INV_QTE_INV) !Invoice > Quote Inventory upd
- .
- .
- EJECT('FILE LAYOUTS')
- CLIENTS FILE,PRE(CLI),CREATE,RECLAIM
- CLIENT_KEY KEY(CLI:CLIENT),DUP,NOCASE,OPT
- CLI_NO_KEY KEY(CLI:CLIENT_NO),NOCASE,OPT
- ZIP_KEY KEY(CLI:ZIP),DUP,NOCASE,OPT
- COMMENTS MEMO(490) !Comments
- RECORD RECORD
- CLIENT_NO LONG !CLIENT NUMBER
- CLIENT STRING(32) !Client Name
- ORDEREDBY STRING(32) !Ordered By
- ADD1 STRING(32) !Address #1
- ADD2 STRING(32) !Address #2
- CITY STRING(17) !City
- STATE STRING(3) !State
- ZIP STRING(10) !Zip Code
- DAYPHONE DECIMAL(10,0) !Day Phone
- EXTENSION STRING(10) !Extension
- EVEPHONE DECIMAL(10,0) !Eve Phone
- FAXPHONE DECIMAL(10,0) !Fax Phone
- PRICECLASS BYTE !Price Class
- TAXPCT REAL !Sales Tax Percentage
- CREDITLIMIT REAL !Credit Limit
- ROUTE LONG !delivery route
- . .
- GROUP,OVER(CLI:COMMENTS)
- CLI_MEMO_ROW STRING(70),DIM(7)
- .
-
- INVNTORY FILE,PRE(INV),CREATE,RECLAIM
- BY_GROUP KEY(INV:GROUPNAME,INV:PARTNUM),NOCASE,OPT
- BY_PARTNUM KEY(INV:PARTNUM),NOCASE,OPT
- BY_VENDOR KEY(INV:VENDOR,INV:GROUPNAME,INV:PARTNUM),DUP,NOCASE,OPT
- BY_LOCATION KEY(INV:LOCATION,INV:GROUPNAME,INV:PARTNUM),DUP,NOCASE,OPT
- BY_GROUP_PRC KEY(INV:GROUPNAME,INV:CLASS1,INV:PARTNUM),DUP,NOCASE,OPT
- COMMENTS MEMO(108) !Printable Comments
- RECORD RECORD
- PARTNUM STRING(20) !Part Number
- GROUPNAME STRING(25) !Group Name
- PRODDESC STRING(35) !Product Description
- COST REAL !Item Cost
- MFGRETAIL REAL !MFG Retail Price
- CLASS1 REAL !Price Class 1
- CLASS2 REAL !Price Class 2
- CLASS3 REAL !Price Class 3
- STOCK_ADJUST STRING(3) !Adjust Stock on Sold Items?
- TAXABLE STRING(3) !Taxable Flag
- VENDOR STRING(32) !Vendor Name
- NOTES1 STRING(27) !Non-Print #1
- NOTES2 STRING(27)
- NOTES3 STRING(27)
- NOTES4 STRING(27)
- PROD_SIZE DECIMAL(5,1) !SIZE OF ITEM/PRODUCT
- PROD_WEIGHT DECIMAL(7,2) !WEIGHT IN LBS.
- LOCATION LONG !LOCATION
- ON_HAND REAL !Qty On Hand
- ON_ORDER REAL !Qty On Order
- MIN_QTY REAL !Minimum Quantity
- . .
- GROUP,OVER(INV:COMMENTS)
- INV_MEMO_ROW STRING(27),DIM(4)
- .
-
- ORDERS FILE,PRE(ORD),CREATE,RECLAIM
- ORDER_KEY KEY(ORD:ORDER_NUM),NOCASE,OPT
- TYPE_KEY KEY(ORD:TYPE,ORD:CLIENT,ORD:DATE),DUP,NOCASE,OPT
- TYPE_DATE KEY(ORD:TYPE,ORD:DATE),DUP,NOCASE,OPT
- OPEN_KEY KEY(ORD:OPEN,ORD:CLIENT),DUP,OPT
- ORD_CLI_KEY KEY(ORD:CLIENT,ORD:DATE),DUP,NOCASE,OPT
- NOTES MEMO(105) !Order Notes
- RECORD RECORD
- ORDER_NUM LONG !Order Number
- INVOICE_NUM LONG !Invoice #
- INV_ADJUSTED STRING(1) !Inventory Adjusted?
- CLIENT STRING(32) !Client Name
- CLIENT_NO LONG
- TYPE STRING(9) !Order Type
- DATE LONG !Order Date
- SALESPERSON STRING(32) !Salesperson
- ORDERREF STRING(28) !Order Reference
- PO STRING(25) !CLIENT PURCHASE ORDER NUMBER
- PRICECLASS BYTE !Price Class
- TAXPCT REAL !Tax Percentage
- TAX REAL !Tax on Order
- PAYMETHOD STRING(20) !Method of Payment
- TERMS STRING(13) !Payment Terms
- CCNUM STRING(25) !Credit Card Number
- EXPDATE STRING(10) !Credit Card Expiration Date
- AUTHORIZE STRING(12) !CC Authorization
- SHIPTO STRING(32) !Ship To - Name
- SHIPADD1 STRING(32) !Ship To - Address #1
- SHIPADD2 STRING(32) !Ship To - Address #2
- SHIPCITY STRING(17) !Ship To - City
- SHIPSTATE STRING(3) !Ship To - State
- SHIPZIP STRING(10) !Ship To - Zip Code
- SHIPATTN STRING(26) !Ship To - Attention
- SHIP_TRACK STRING(25) !TRACKING NUMBER FOR UPS/FED_X
- SHIP_AMT REAL !SHIPPING COSTS
- OTHER_AMT REAL !MISC CHARGES- CUSTOM
- COD_AMT REAL
- COST REAL !Order Cost
- SUBTOTAL REAL !Order Subtotal
- TOTAL REAL !Order Total
- PAYMENTS REAL !Payments
- BALANCE REAL !Balance Due
- OPEN STRING(4) !Order Open?
- TAXABLE REAL
- . .
- GROUP,OVER(ORD:NOTES)
- ORD_MEMO_ROW STRING(35),DIM(3)
- .
-
- ITEM_ORD FILE,PRE(ITE),CREATE
- ORD_KEY KEY(ITE:ORDER_NUM),DUP,NOCASE,OPT
- PRC_ORD_KEY KEY(ITE:ORDER_NUM,ITE:ORDERPRICE),DUP,NOCASE,OPT
- PICK_LST_KEY KEY(ITE:LOCATION,ITE:CLIENT_NO,ITE:DATE),DUP,NOCASE,OPT
- PICK_LST_K2 KEY(ITE:LOCATION,ITE:PART_NUM),DUP,NOCASE,OPT
- RECORD RECORD
- ORDER_NUM LONG !Order Number
- PART_NUM STRING(20) !Part Number
- CLIENT_NO LONG
- DATE LONG
- QTY LONG !Quantity
- UNITCOST REAL !Unit Cost
- PRODDESC STRING(35) !Product Description
- LOCATION LONG
- PROD_SIZE DECIMAL(4,1)
- SERIAL_NUM STRING(35) !SERIAL NUMBERS
- ORDERPRICE REAL !Order Price
- . .
-
- PURC_ORD FILE,PRE(PUR),CREATE,RECLAIM
- PO_KEY KEY(PUR:PO_NUM),NOCASE,OPT
- PO_OPEN KEY(PUR:OPEN,PUR:PO_NUM),DUP,NOCASE,OPT
- PO_REFERNCE KEY(PUR:ORDERREF),NOCASE,OPT
- PO_STATUS KEY(PUR:OPEN,PUR:DATE),DUP,NOCASE,OPT
- NOTES MEMO(105) !Order Notes
- RECORD RECORD
- PO_NUM LONG !PO Number
- DATE LONG !Order Date
- ORDERREF STRING(28) !Order Reference
- SHIPPING REAL
- TOTAL REAL !Order Total
- OPEN STRING(4) !Order Open?
- . .
- GROUP,OVER(PUR:NOTES)
- PUR_MEMO_ROW STRING(35),DIM(3)
- .
-
- ITEM_PO FILE,PRE(ITP),CREATE
- ORD_KEY KEY(ITP:PO_NUM,ITP:INV_STATUS,ITP:PART_NUM),DUP,NOCASE,OPT
- ITP_PO_KEY KEY(ITP:PO_NUM),DUP,NOCASE,OPT
- RECORD RECORD
- PO_NUM LONG !PURCHASE ORDER NUMBER
- INV_STATUS STRING(1) !Y-ADJUSTED,N-ORDERED,B-BACKORD
- PART_NUM STRING(20) !Part Number
- DATE LONG
- QTY LONG !Quantity
- PRODDESC STRING(35) !Product Description
- UNITCOST REAL !Unit Cost
- ORDERPRICE REAL !Order Price
- . .
-
- PAYMETHD FILE,PRE(PAY),CREATE,RECLAIM
- METHOD_KEY KEY(PAY:METHOD_PAY),NOCASE,OPT
- RECORD RECORD
- METHOD_PAY STRING(20) !Method Of Payment
- TYPE STRING(8) !type of payment
- . .
-
- TERMS FILE,PRE(TER),CREATE,RECLAIM
- TERM_KEY KEY(TER:TERMS),NOCASE,OPT
- RECORD RECORD
- TERMS STRING(13) !Terms of Order
- . .
-
- VENDORS FILE,PRE(VEN),CREATE,RECLAIM
- VEN_KEY KEY(VEN:VENDOR),DUP,NOCASE,OPT
- VEN_NUM_KEY KEY(VEN:VENDOR_NUM),NOCASE,OPT
- ZIP_KEY KEY(VEN:ZIP),DUP,NOCASE,OPT
- COMMENTS MEMO(350) !Comments
- RECORD RECORD
- VENDOR_NUM LONG
- VENDOR STRING(40) !Vendor Name
- ADD1 STRING(32) !Address #1
- ADD2 STRING(32) !Address #2
- CITY STRING(17) !City
- STATE STRING(3) !State
- ZIP STRING(10) !Zip Code
- CONTACT STRING(32) !Contact Person
- DAYPHONE DECIMAL(10,0) !Phone Number
- EXTENSION STRING(10) !Extension
- EVEPHONE DECIMAL(10,0) !Phone Number #2
- FAXPHONE DECIMAL(10,0) !Fax Phone Number
- ACCTNUM STRING(20) !Account Number
- TERMS STRING(32) !Terms
- . .
- GROUP,OVER(VEN:COMMENTS)
- VEN_MEMO_ROW STRING(70),DIM(5)
- .
-
- SALESPER FILE,PRE(SAL),CREATE,RECLAIM
- SALES_KEY KEY(SAL:SALESPERSON),NOCASE,OPT
- RECORD RECORD
- SALESPERSON STRING(32) !Salesperson Name
- . .
-
- PAYMENTS FILE,PRE(PMT),CREATE,RECLAIM
- ORDER_KEY KEY(PMT:ORDER_NUM),DUP,NOCASE,OPT
- INVOICE_KEY KEY(PMT:INVOICE_NUM),DUP,NOCASE,OPT
- CLIENT_KEY KEY(PMT:CLIENT),DUP,NOCASE,OPT
- DATE_KEY KEY(PMT:DATE),DUP,NOCASE,OPT
- CLI_DATE_KEY KEY(PMT:CLIENT_NO,PMT:DATE),DUP,NOCASE,OPT
- RECORD RECORD
- ORDER_NUM LONG !Order Number
- INVOICE_NUM LONG !Invoice Number
- CLIENT STRING(32) !Client Name
- CLIENT_NO LONG !CLIENT NUMBER
- DATE LONG !Deposit Date
- REFERENCE STRING(15) !Deposit Reference
- PAYMENT REAL !Payment Paid
- . .
-
- EJECT('GLOBAL MEMORY VARIABLES')
- ACTION SHORT !0 = NO ACTION
- !1 = ADD RECORD
- !2 = CHANGE RECORD
- !3 = DELETE RECORD
- !4 = LOOKUP FIELD
- !5 = AUTONUMKEY ADD
-
- ascii_tmp dos,ascii,name(mem:device) !#### Eckenroed & Associates
- record !#### Eckenroed & Associates
- string(1) !#### Eckenroed & Associates
- . . !#### Eckenroed & Associates
-
- GROUP,PRE(MEM)
- MESSAGE STRING(30) !Global Message Area
- DUMMY STRING(1) !Dummy Field
- DUMMY2 STRING(1) !Dummy Field
- PAGE SHORT !Report Page Number
- LINE SHORT !Report Line Number
- DEVICE STRING(30) !Report Device
- COST REAL !Temporary hold - system cost
- SUBTOTAL REAL !Temporary hold - system total
- TAX REAL !Order Tax
- SHIP_AMT REAL !SHIPPING CHAGES
- TAXABLE REAL !Taxable Total
- TOTAL REAL !Order Total
- DEPOSIT REAL !Order Deposit
- PAYMENTS REAL !Order Payments
- BALANCE REAL !Balance Due
- OPEN STRING(4) !Open Invoice?
- BEGDATE LONG !Beginning Date
- ENDDATE LONG !Ending Date
- CLIENT STRING(32) !Client Name
- SALESPERSON STRING(32)
- START_NUM LONG
- END_NUM LONG(9999)
- START_DATE LONG
- END_DATE LONG
- CLIENTS STRING(30) !TEMP RANDOM CLIENTS FOR REPORT
- .
-
- EJECT('CODE SECTION')
- CODE
- LOOP !#### Eckenroed & Associates
- mem:device = 'RP3' | !#### Eckenroed & Associates
- & RANDOM(1000,9999) | !#### Eckenroed & Associates
- & '.TMP' !#### Eckenroed & Associates
- open(ascii_tmp) !#### Eckenroed & Associates
- if errorcode() = 2 !#### Eckenroed & Associates
- close(ascii_tmp) !#### Eckenroed & Associates
- break !#### Eckenroed & Associates
- . !#### Eckenroed & Associates
- close(ascii_tmp) !#### Eckenroed & Associates
- . !#### Eckenroed & Associates
-
- SETHUE(7,0) !SET WHITE ON BLACK
- BLANK ! AND BLANK
- HELP('SASHELP.HLP') !OPEN THE HELP FILE
- ! G_OPENFILES !OPEN OR CREATE FILES
- SETHUE() ! THE SCREEN
- MAIN_MENU !* T H E M A I N M E N U *
- RETURN !EXIT TO DOS
-
- G_OPENFILES PROCEDURE !OPEN FILES & CHECK FOR ERROR
- CODE
- RECOVER(120) !HOLDS TIMEOUT IN 120 SECONDS
- SHOW(25,1,CENTER('SHARING FILE: ' & 'COMPANY',80))
- IF COM:NETWORKED = 'Y' THEN SHARE(COMPANY) ELSE OPEN(COMPANY).
- IF ERROR()
- CASE ERRORCODE()
- OF 46
- SETHUE(0,7)
- SHOW(25,1,CENTER('REBUILDING KEY FILES FOR COMPANY',80))
- OPEN(COMPANY)
- IF ERROR()
- SHOW(25,1,CENTER('EXCLUSIVE ACCESS REQUIRED TO' |
- & 'REBUILD KEYS FOR COMPANY',80))
- ASK
- RETURN
- ELSE
- BUILD(COMPANY)
- CLOSE(COMPANY)
- SHARE(COMPANY)
- SETHUE(7,0)
- BLANK(25,1,1,80)
- .
- OF 2
- CREATE(COMPANY)
- CLOSE(COMPANY)
- SHARE(COMPANY)
- ELSE
- LOOP
- STOP('Cannot Share COMPANY - Error: ' & ERROR())
- .
- . .
-
- SHOW(25,1,CENTER('SHARING FILE: ' & 'CLIENTS',80))
- SHARE(CLIENTS)
- IF ERROR()
- CASE ERRORCODE()
- OF 46
- SETHUE(0,7)
- SHOW(25,1,CENTER('REBUILDING KEY FILES FOR CLIENTS',80))
- OPEN(CLIENTS)
- IF ERROR()
- SHOW(25,1,CENTER('EXCLUSIVE ACCESS REQUIRED TO' |
- & 'REBUILD KEYS FOR CLIENTS',80))
- ASK
- RETURN
- ELSE
- BUILD(CLIENTS)
- CLOSE(CLIENTS)
- SHARE(CLIENTS)
- SETHUE(7,0)
- BLANK(25,1,1,80)
- .
- OF 2
- CREATE(CLIENTS)
- CLOSE(CLIENTS)
- SHARE(CLIENTS)
- ELSE
- LOOP
- STOP('Cannot Share CLIENTS - Error: ' & ERROR())
- .
- . .
-
- SHOW(25,1,CENTER('SHARING FILE: ' & 'INVNTORY',80))
- SHARE(INVNTORY)
- IF ERROR()
- CASE ERRORCODE()
- OF 46
- SETHUE(0,7)
- SHOW(25,1,CENTER('REBUILDING KEY FILES FOR INVNTORY',80))
- OPEN(INVNTORY)
- IF ERROR()
- SHOW(25,1,CENTER('EXCLUSIVE ACCESS REQUIRED TO' |
- & 'REBUILD KEYS FOR INVNTORY',80))
- ASK
- RETURN
- ELSE
- BUILD(INVNTORY)
- CLOSE(INVNTORY)
- SHARE(INVNTORY)
- SETHUE(7,0)
- BLANK(25,1,1,80)
- .
- OF 2
- CREATE(INVNTORY)
- CLOSE(INVNTORY)
- SHARE(INVNTORY)
- ELSE
- LOOP
- STOP('Cannot Share INVNTORY - Error: ' & ERROR())
- .
- . .
-
- SHOW(25,1,CENTER('SHARING FILE: ' & 'ORDERS',80))
- SHARE(ORDERS)
- IF ERROR()
- CASE ERRORCODE()
- OF 46
- SETHUE(0,7)
- SHOW(25,1,CENTER('REBUILDING KEY FILES FOR ORDERS',80))
- OPEN(ORDERS)
- IF ERROR()
- SHOW(25,1,CENTER('EXCLUSIVE ACCESS REQUIRED TO' |
- & 'REBUILD KEYS FOR ORDERS',80))
- ASK
- RETURN
- ELSE
- BUILD(ORDERS)
- CLOSE(ORDERS)
- SHARE(ORDERS)
- SETHUE(7,0)
- BLANK(25,1,1,80)
- .
- OF 2
- CREATE(ORDERS)
- CLOSE(ORDERS)
- SHARE(ORDERS)
- ELSE
- LOOP
- STOP('Cannot Share ORDERS - Error: ' & ERROR())
- .
- . .
-
- SHOW(25,1,CENTER('SHARING FILE: ' & 'ITEM_ORD',80))
- SHARE(ITEM_ORD)
- IF ERROR()
- CASE ERRORCODE()
- OF 46
- SETHUE(0,7)
- SHOW(25,1,CENTER('REBUILDING KEY FILES FOR ITEM_ORD',80))
- OPEN(ITEM_ORD)
- IF ERROR()
- SHOW(25,1,CENTER('EXCLUSIVE ACCESS REQUIRED TO' |
- & 'REBUILD KEYS FOR ITEM_ORD',80))
- ASK
- RETURN
- ELSE
- BUILD(ITEM_ORD)
- CLOSE(ITEM_ORD)
- SHARE(ITEM_ORD)
- SETHUE(7,0)
- BLANK(25,1,1,80)
- .
- OF 2
- CREATE(ITEM_ORD)
- CLOSE(ITEM_ORD)
- SHARE(ITEM_ORD)
- ELSE
- LOOP
- STOP('Cannot Share ITEM_ORD - Error: ' & ERROR())
- .
- . .
-
- SHOW(25,1,CENTER('SHARING FILE: ' & 'PURC_ORD',80))
- SHARE(PURC_ORD)
- IF ERROR()
- CASE ERRORCODE()
- OF 46
- SETHUE(0,7)
- SHOW(25,1,CENTER('REBUILDING KEY FILES FOR PURC_ORD',80))
- OPEN(PURC_ORD)
- IF ERROR()
- SHOW(25,1,CENTER('EXCLUSIVE ACCESS REQUIRED TO' |
- & 'REBUILD KEYS FOR PURC_ORD',80))
- ASK
- RETURN
- ELSE
- BUILD(PURC_ORD)
- CLOSE(PURC_ORD)
- SHARE(PURC_ORD)
- SETHUE(7,0)
- BLANK(25,1,1,80)
- .
- OF 2
- CREATE(PURC_ORD)
- CLOSE(PURC_ORD)
- SHARE(PURC_ORD)
- ELSE
- LOOP
- STOP('Cannot Share PURC_ORD - Error: ' & ERROR())
- .
- . .
-
- SHOW(25,1,CENTER('SHARING FILE: ' & 'ITEM_PO',80))
- SHARE(ITEM_PO)
- IF ERROR()
- CASE ERRORCODE()
- OF 46
- SETHUE(0,7)
- SHOW(25,1,CENTER('REBUILDING KEY FILES FOR ITEM_PO',80))
- OPEN(ITEM_PO)
- IF ERROR()
- SHOW(25,1,CENTER('EXCLUSIVE ACCESS REQUIRED TO' |
- & 'REBUILD KEYS FOR ITEM_PO',80))
- ASK
- RETURN
- ELSE
- BUILD(ITEM_PO)
- CLOSE(ITEM_PO)
- SHARE(ITEM_PO)
- SETHUE(7,0)
- BLANK(25,1,1,80)
- .
- OF 2
- CREATE(ITEM_PO)
- CLOSE(ITEM_PO)
- SHARE(ITEM_PO)
- ELSE
- LOOP
- STOP('Cannot Share ITEM_PO - Error: ' & ERROR())
- .
- . .
-
- SHOW(25,1,CENTER('SHARING FILE: ' & 'PAYMETHD',80))
- SHARE(PAYMETHD)
- IF ERROR()
- CASE ERRORCODE()
- OF 46
- SETHUE(0,7)
- SHOW(25,1,CENTER('REBUILDING KEY FILES FOR PAYMETHD',80))
- OPEN(PAYMETHD)
- IF ERROR()
- SHOW(25,1,CENTER('EXCLUSIVE ACCESS REQUIRED TO' |
- & 'REBUILD KEYS FOR PAYMETHD',80))
- ASK
- RETURN
- ELSE
- BUILD(PAYMETHD)
- CLOSE(PAYMETHD)
- SHARE(PAYMETHD)
- SETHUE(7,0)
- BLANK(25,1,1,80)
- .
- OF 2
- CREATE(PAYMETHD)
- CLOSE(PAYMETHD)
- SHARE(PAYMETHD)
- ELSE
- LOOP
- STOP('Cannot Share PAYMETHD - Error: ' & ERROR())
- .
- . .
-
- SHOW(25,1,CENTER('SHARING FILE: ' & 'TERMS',80))
- SHARE(TERMS)
- IF ERROR()
- CASE ERRORCODE()
- OF 46
- SETHUE(0,7)
- SHOW(25,1,CENTER('REBUILDING KEY FILES FOR TERMS',80))
- OPEN(TERMS)
- IF ERROR()
- SHOW(25,1,CENTER('EXCLUSIVE ACCESS REQUIRED TO' |
- & 'REBUILD KEYS FOR TERMS',80))
- ASK
- RETURN
- ELSE
- BUILD(TERMS)
- CLOSE(TERMS)
- SHARE(TERMS)
- SETHUE(7,0)
- BLANK(25,1,1,80)
- .
- OF 2
- CREATE(TERMS)
- CLOSE(TERMS)
- SHARE(TERMS)
- ELSE
- LOOP
- STOP('Cannot Share TERMS - Error: ' & ERROR())
- .
- . .
-
- SHOW(25,1,CENTER('SHARING FILE: ' & 'VENDORS',80))
- SHARE(VENDORS)
- IF ERROR()
- CASE ERRORCODE()
- OF 46
- SETHUE(0,7)
- SHOW(25,1,CENTER('REBUILDING KEY FILES FOR VENDORS',80))
- OPEN(VENDORS)
- IF ERROR()
- SHOW(25,1,CENTER('EXCLUSIVE ACCESS REQUIRED TO' |
- & 'REBUILD KEYS FOR VENDORS',80))
- ASK
- RETURN
- ELSE
- BUILD(VENDORS)
- CLOSE(VENDORS)
- SHARE(VENDORS)
- SETHUE(7,0)
- BLANK(25,1,1,80)
- .
- OF 2
- CREATE(VENDORS)
- CLOSE(VENDORS)
- SHARE(VENDORS)
- ELSE
- LOOP
- STOP('Cannot Share VENDORS - Error: ' & ERROR())
- .
- . .
-
- SHOW(25,1,CENTER('SHARING FILE: ' & 'SALESPER',80))
- SHARE(SALESPER)
- IF ERROR()
- CASE ERRORCODE()
- OF 46
- SETHUE(0,7)
- SHOW(25,1,CENTER('REBUILDING KEY FILES FOR SALESPER',80))
- OPEN(SALESPER)
- IF ERROR()
- SHOW(25,1,CENTER('EXCLUSIVE ACCESS REQUIRED TO' |
- & 'REBUILD KEYS FOR SALESPER',80))
- ASK
- RETURN
- ELSE
- BUILD(SALESPER)
- CLOSE(SALESPER)
- SHARE(SALESPER)
- SETHUE(7,0)
- BLANK(25,1,1,80)
- .
- OF 2
- CREATE(SALESPER)
- CLOSE(SALESPER)
- SHARE(SALESPER)
- ELSE
- LOOP
- STOP('Cannot Share SALESPER - Error: ' & ERROR())
- .
- . .
-
- SHOW(25,1,CENTER('SHARING FILE: ' & 'PAYMENTS',80))
- SHARE(PAYMENTS)
- IF ERROR()
- CASE ERRORCODE()
- OF 46
- SETHUE(0,7)
- SHOW(25,1,CENTER('REBUILDING KEY FILES FOR PAYMENTS',80))
- OPEN(PAYMENTS)
- IF ERROR()
- SHOW(25,1,CENTER('EXCLUSIVE ACCESS REQUIRED TO' |
- & 'REBUILD KEYS FOR PAYMENTS',80))
- ASK
- RETURN
- ELSE
- BUILD(PAYMENTS)
- CLOSE(PAYMENTS)
- SHARE(PAYMENTS)
- SETHUE(7,0)
- BLANK(25,1,1,80)
- .
- OF 2
- CREATE(PAYMENTS)
- CLOSE(PAYMENTS)
- SHARE(PAYMENTS)
- ELSE
- LOOP
- STOP('Cannot Share PAYMENTS - Error: ' & ERROR())
- .
- . .
-
- RECOVER() !DISARM RECOVER
- ! BLANK !BLANK THE SCREEN
-
-
-
- SOURCE
-
- !---------------- Eckenroed & Associates 02-90 -----------------------
- !
- ! REPORT3.LEM for use with CLARION batch 2010
- !
- ! This file contains the procedures used to show a report on the screen
- ! and allow a user to preview it be for printing or saving as a file.
- !
- ! ROUTE_FILE - Main controller. routes report to screen, disk, printer
- ! SHOW_fILE - Opens a screen for the file and calls SHOWTEXT
- ! GET_FILENAME - prompts the user to enter a vaild DOS file name
- ! GET_CPY - Prompts the user to enter the number of copies to be printed
- ! PRINTR_READY - Function that checks the printer to see if it is ready.
- !
- ! copyright 1990 by Eckenroed & Associates, Boise, Idaho
- !---------------------------------------------------------------------
-
- !═══════════════════════════════════════════════════════════════════════════════
- ROUTE_FILE PROCEDURE(INPUT_FILE)
-
- !---------------------------------------------------------------------
- ! copyright 1990 by Eckenroed & Associates, Boise, Idaho
- !---------------------------------------------------------------------
-
- INPUT_FILE STRING(78) !INPUT FILE TO SHOW
-
- SCREEN SCREEN WINDOW(7,47),PRE(SCR),HLP('ROUTE'),HUE(0,3)
- ROW(1,1) STRING('╔═{45}╗')
- ROW(2,1) REPEAT(3);STRING('║<0{45}>║') .
- ROW(5,1) STRING('╟─{45}╢')
- ROW(6,1) STRING('║<0{45}>║')
- ROW(7,1) STRING('╚═{45}╝')
- ROW(3,6) STRING('Send report to:')
- COL(29) STRING(',')
- COL(38) STRING(',')
- ROW(6,3) STRING('F1')
- COL(6) STRING('Help')
- COL(38) STRING('ESC')
- COL(42) STRING('Quit')
- ROW(2,7) ENTRY,USE(?FIRST_FIELD)
- ROW(4,8) MENU(@S35),USE(?MENU_FIELD),HUE(4,3),SEL(4,3)
- ROW(3,23) STRING('Screen'),HUE(0,3),SEL(11,0) |
- DESC('Send Report to Screen for Viewing')
- COL(31) STRING('Printer'),HUE(0,3),SEL(11,0) |
- DESC(' Print the Report on the Printer')
- COL(40) STRING('Disk'),HUE(0,3),SEL(11,0) |
- DESC(' Print the report to a file')
- . .
- BINARY DOS,NAME(INPUT_FILE) ! FILE TO DISPLAY
- RECORD
- BINREC STRING(255)
- . .
-
- PRINTER DOS,NAME(r3m:lpt)
- RECORD
- PRTREC STRING(255)
- . .
-
- cancel_msg group
- STRING('<13,10,10>') !skip down 2 lines
- STRING('((Cancelled))')
- STRING('<13,10>')
- STRING('<18>') !reset printer to normal
- STRING('<12>') !issue formfeed
- .
-
- PRT_SCN SCREEN WINDOW(6,38),HUE(1,7)
- ROW(5,10) PAINT(1,21),HUE(4,7)
- ROW(1,1) STRING('╔═{36}╗')
- ROW(2,1) REPEAT(4);STRING('║<0{36}>║') .
- ROW(6,1) STRING('╚═{36}╝')
- ROW(3,12) STRING('Printing report ....'),BLK
- ROW(5,10) STRING('(Press ESC to Cancel)')
- .
-
- COPY_SCN SCREEN WINDOW(5,38),HUE(1,7)
- ROW(1,1) STRING('╔═{36}╗')
- ROW(2,1) REPEAT(3);STRING('║<0{36}>║') .
- ROW(5,1) STRING('╚═{36}╝')
- ROW(3,12) STRING('Printing report ....'),BLK
- .
- copies byte
- filename string(78)
-
- code
- open(screen)
- select(?menu_field)
- loop
- accept
- case field()
- of ?first_field
- remove(BINARY)
- return
- of ?menu_field
- execute choice()
- do show_file
- do prnt_file
- do copy_file
- . !end execute
- . !end case
- select(?menu_field)
- . !end loop
-
- show_file routine
- show_file(input_file,1)
-
- prnt_file routine
- copies = get_cpy() ! get number to print
- if keycode() = ESC_KEY then exit.
-
- if printr_ready()
- else
- exit
- .
- IF copies < 2 THEN copies = 1.
- LOOP copies TIMES
- OPEN(PRT_SCN)
- open(BINARY) ! OPEN FILE TO DISPLAY
- set(BINARY)
- open(PRINTER)
- LOOP UNTIL EOF(BINARY)
- if keyboard()
- ask()
- if keycode() = ESC_KEY
- prtrec = cancel_msg
- add(PRINTER,size(cancel_msg))
- close(BINARY)
- close(PRINTER)
- remove(BINARY)
- return
- ..
- NEXT(BINARY)
- prtrec=binrec
- ADD(PRINTER,bytes(BINARY)) !print the record
- . .
- close(BINARY)
- close(PRINTER)
- remove(BINARY)
- return
-
- copy_file routine
- filename = get_filename()
- if keycode() = ESC_KEY or keycode() = REJECT_KEY then exit.
- open(copy_scn)
- copy(BINARY,FILENAME)
- close(copy_scn)
-
-
- !═══════════════════════════════════════════════════════════════════════════════
- SHOW_FILE PROCEDURE(INPUT_FILE,SCR_NO) !SCR_NO: 1=FULL 2=WINDOW
-
- !---------------------------------------------------------------------
- ! copyright 1989 by Eckenroed & Associates, Boise, Idaho
- !---------------------------------------------------------------------
-
- input_file string(78) !input file to show
- scr_no byte !1=screen 2=screen2
-
- SCREEN SCREEN WINDOW(25,80),HLP('SHOWFIL'),HUE(0,7)
- ROW(25,2) PAINT(1,78),HUE(7,1)
- ROW(8,26) STRING('╔═{26}╗'),HUE(1,7)
- ROW(9,26) REPEAT(3);STRING('║<0{26}>║'),HUE(1,7) .
- ROW(12,26) STRING('╚═{26}╝'),HUE(1,7)
- ROW(25,2) STRING('<24,25,27,26>'),HUE(14,1)
- ROW(9,33) STRING('Please Wait'),HUE(1,7)
- ROW(11,32) STRING('Reading File...'),HUE(20,7)
- ROW(25,7) STRING('Scroll'),ENH
- COL(16) STRING('PGUP'),HUE(14,1)
- COL(21) STRING('Page up'),ENH
- COL(31) STRING('PGDN'),HUE(14,1)
- COL(36) STRING('Page down'),ENH
- COL(48) STRING('END'),HUE(14,1)
- COL(52) STRING('bottom'),ENH
- COL(61) STRING('HOME'),HUE(14,1)
- COL(66) STRING('top'),ENH
- COL(72) STRING('ESC '),HUE(14,1)
- COL(76) STRING('Quit'),ENH
- .
-
- SCREEN2 SCREEN WINDOW(15,67),HLP('SHOWFIL'),HUE(0,3)
- ROW(6,21) PAINT(3,26),HUE(1,7)
- ROW(14,2) PAINT(1,65),HUE(11,1)
- ROW(1,1) STRING('╔═{65}╗'),HUE(15,3)
- ROW(2,1) REPEAT(13);STRING('║<0{65}>║'),HUE(15,3) .
- ROW(15,1) STRING('╚═{65}╝'),HUE(15,3)
- ROW(5,20) STRING('╔═{26}╗'),HUE(1,7)
- ROW(6,20) REPEAT(3);STRING('║<0{26}>║'),HUE(1,7) .
- ROW(9,20) STRING('╚═{26}╝'),HUE(1,7)
- ROW(14,18) STRING('<27,18,26>'),HUE(15,1)
- ROW(6,27) STRING('Please Wait')
- ROW(8,26) STRING('Reading File...'),HUE(20,7)
- ROW(14,3) STRING('Movement'),HUE(14,1)
- COL(11) STRING(' '),HUE(15,1)
- COL(12) STRING('Keys:'),HUE(14,1)
- COL(17) STRING(' '),HUE(15,1)
- COL(21) STRING(' Scroll PgUp PgDn Home End {6}'),HUE(15,1)
- COL(57) STRING('ESC:'),HUE(14,1)
- COL(61) STRING(' Quit '),HUE(15,1)
- .
- ERRSCN SCREEN WINDOW(9,45),AT(7,18),PRE(SCR),HUE(15,4)
- ROW(1,1) STRING('╔═{43}╗')
- ROW(2,1) REPEAT(7);STRING('║<0{43}>║') .
- ROW(9,1) STRING('╚═{43}╝')
- ROW(3,17) STRING('**'),HUE(14,4)
- COL(20) STRING('ERROR **'),HUE(14,4)
- ROW(7,9) STRING('Press any key to continue...'),HUE(14,4)
- MSG ROW(5,4) STRING(40),ENH
- .
-
- !---- these parameters specify screen area and color for showtext -----
- ! screen must have at least 3 rows and 10 columns and can't use row 25
-
- R SHORT !row of top-left corner
- C SHORT !column of top-left corner
- RS SHORT !num of rows down
- CS SHORT !num of columns across
- FG SHORT !forground color
- BG SHORT !background color
-
- CODE
-
- case scr_no
- of 2
- !-- create parameters for small window ----------------
- open(screen2)
- r = row(screen2)+1 !top left corner (row)
- c = col(screen2)+2 !top left corner (column)
- rs = rows(screen2)-3 !number of rows down
- cs = cols(screen2)-4 !number of columns accross
- fg = forehue(r,c) !foreground color
- bg = backhue(r,c) !background color
-
- else !(defualt)
- !-- create parameters for full screen -----------------
- open(screen)
- r = row(screen) !top left corner (row)
- c = col(screen) !top left corner (column)
- rs = rows(screen)-1 !number of rows down
- cs = cols(screen) !number of columns accross
- fg = forehue(r,c) !foreground color
- bg = backhue(r,c) !background color
- . !case
-
- !--- show the report -----
- showtext(input_file,r,c,rs,cs,fg,bg) !show file in the window
-
- if error()
- open(errscn)
- scr:msg = center(error(),size(scr:msg)) !'bad data' means invalid parmeter
- ask()
- close(errscn)
- . !if
- !═══════════════════════════════════════════════════════════════════════════════
- get_filename FUNCTION
-
- !---------------------------------------------------------------------
- ! copyright 1989 by Eckenroed & Associates, Boise, Idaho
- !---------------------------------------------------------------------
-
- SCREEN SCREEN WINDOW(6,49),PRE(SCR),HLP('FILENAME'),HUE(0,3)
- ROW(1,1) STRING('╔═{47}╗')
- ROW(2,1) REPEAT(4);STRING('║<0{47}>║') .
- ROW(6,1) STRING('╚═{47}╝')
- ROW(5,3) STRING('F1')
- COL(6) STRING('Help')
- COL(40) STRING('ESC')
- COL(44) STRING('Quit')
- ROW(3,14) ENTRY,USE(?FIRST_FIELD)
- COL(4) STRING('File Name:')
- COL(15) ENTRY(@S30),USE(FULL_NAME),HUE(0,3),SEL(11,0)
- ROW(5,14) PAUSE('Press ENTER to continue'),USE(?PAUSE_FIELD) |
- HUE(4,3)
- COL(37) ENTRY,USE(?LAST_FIELD)
- .
-
-
- full_name string(78)
-
- EJECT
- CODE
- OPEN(SCREEN) !OPEN THE SCREEN
- SETCURSOR !TURN OFF ANY CURSOR
- DISPLAY !DISPLAY THE FIELDS
- LOOP !LOOP THRU ALL THE FIELDS
- ALERT !RESET ALERTED KEYS
- ALERT(ACCEPT_KEY) !ALERT SCREEN ACCEPT KEY
- ALERT(REJECT_KEY) !ALERT SCREEN REJECT KEY
- ACCEPT !READ A FIELD
- IF KEYCODE() = REJECT_KEY THEN RETURN(''). !RETURN ON SCREEN REJECT KEY
- EDIT_RANGE# = FIELD() !SET ONE FIELD EDIT RANGE
- IF KEYCODE() = ACCEPT_KEY !ON SCREEN ACCEPT KEY
- UPDATE ! MOVE ALL FIELDS FROM SCREEN
- EDIT_RANGE# = FIELDS() ! AND EDIT REMAINING FIELDS
- . !
- LOOP FIELD# = FIELD() TO EDIT_RANGE# !EDIT FIELDS IN THE EDIT RANGE
- CASE FIELD# !JUMP TO FIELD EDIT ROUTINE
- OF ?FIRST_FIELD !FROM THE FIRST FIELD
- IF KEYCODE() = ESC_KEY THEN RETURN(''). ! RETURN ON ESC KEY
-
- OF ?full_name !Report Device Name
- if full_name = mem:device
- select(?)
- beep
- cycle
- .
- full_name = filevalid(full_name) !Filevalid returns full path
- display(?)
- if error() ! and sets error if invalid
- select(?) !Also tries to clean up
- beep ! filename
- cycle
- .
- OF ?PAUSE_FIELD !ON PAUSE FIELD
- IF KEYCODE() <> ENTER_KEY | !IF NOT ENTER KEY
- AND KEYCODE() <> ACCEPT_KEY !AND NOT CTRL-ENTER KEY
- BEEP ! SOUND KEYBOARD ALARM
- SELECT(?PAUSE_FIELD) ! AND STAY ON PAUSE FIELD
- .
- OF ?LAST_FIELD !FROM THE LAST FIELD
- ACTION = 0 ! SET ACTION TO COMPLETE
- RETURN(full_name) ! AND RETURN TO CALLER
- . . .
-
- !═══════════════════════════════════════════════════════════════════════════════
-
-
- get_cpy FUNCTION
- !---------------------------------------------------------------------
- ! copyright 1989 by Eckenroed & Associates, Boise, Idaho
- !
- ! Alternative to get_cpy in report39.cla. This allows LPT# to be
- ! changed and shows the number of pages to print.
- !
- ! To use simpley replace get_cpy in report39.cla with this function
- !---------------------------------------------------------------------
-
- SCREEN SCREEN WINDOW(9,49),PRE(SCR),HLP('GET_CPY2'),HUE(1,7)
- ROW(1,1) STRING('╔═{47}╗')
- ROW(2,1) REPEAT(5);STRING('║<0{47}>║') .
- ROW(7,1) STRING('╟─{47}╢')
- ROW(8,1) STRING('║<0{47}>║')
- ROW(9,1) STRING('╚═{47}╝')
- ROW(3,25) STRING('(1 to 9)')
- ROW(4,25) STRING('(')
- COL(45) STRING(')')
- ROW(6,15) STRING('(Number of pages:')
- COL(35) STRING(')')
- ROW(8,3) STRING('F1 Help')
- COL(40) STRING('ESC Quit')
- ROW(3,38) ENTRY,USE(?FIRST_FIELD)
- COL(5) STRING('# of Copies? :')
- COL(20) ENTRY(@N1),USE(COPIES),HUE(1,7),SEL(11,0),INS
- ROW(4,5) STRING('Printer Port :')
- COL(20) MENU(@S4),USE(R3M:LPT),HUE(1,7),SEL(11,0)
- COL(26) STRING('LPT1'),HUE(1,7),SEL(11,0)
- COL(31) STRING('LPT2'),HUE(1,7),SEL(11,0)
- COL(36) STRING('LPT3'),HUE(1,7),SEL(11,0)
- COL(41) STRING('LPT4'),HUE(1,7),SEL(11,0)
- .
- PAGES ROW(6,32) STRING(@N3)
- ROW(8,14) PAUSE('Press ENTER to Continue'),USE(?PAUSE),HUE(4,7)
- ROW(3,28) ENTRY,USE(?LAST_FIELD)
- .
- COPIES BYTE
-
- EJECT
- CODE
- OPEN(SCREEN) !OPEN THE SCREEN
- SETCURSOR !TURN OFF ANY CURSOR
- copies = 1 !set default number
- DISPLAY !DISPLAY THE FIELDS
- LOOP !LOOP THRU ALL THE FIELDS
- scr:pages = r3m:pages * copies
- ALERT !RESET ALERTED KEYS
- ALERT(ACCEPT_KEY) !ALERT SCREEN ACCEPT KEY
- ALERT(REJECT_KEY) !ALERT SCREEN REJECT KEY
- ACCEPT !READ A FIELD
- IF KEYCODE() = REJECT_KEY THEN RETURN(0). !RETURN ON SCREEN REJECT KEY
- EDIT_RANGE# = FIELD() !SET ONE FIELD EDIT RANGE
- IF KEYCODE() = ACCEPT_KEY !ON SCREEN ACCEPT KEY
- UPDATE ! MOVE ALL FIELDS FROM SCREEN
- EDIT_RANGE# = FIELDS() ! AND EDIT REMAINING FIELDS
- . !
- LOOP FIELD# = FIELD() TO EDIT_RANGE# !EDIT FIELDS IN THE EDIT RANGE
- CASE FIELD# !JUMP TO FIELD EDIT ROUTINE
- OF ?FIRST_FIELD !FROM THE FIRST FIELD
- IF KEYCODE() = ESC_KEY THEN RETURN(0). ! RETURN ON ESC KEY
-
- OF ?copies !number of copies to print
- IF copies = '' !IF REQUIRED FIELD IS EMPTY
- BEEP ! SOUND KEYBOARD ALARM
- SELECT(?copies) ! AND STAY ON THIS FIELD
- BREAK !
- .
- IF ~INRANGE(copies,1,9) !IF FIELD IS OUT OF RANGE
- BEEP ! SOUND KEYBOARD ALARM
- SELECT(?copies) ! AND STAY ON THIS FIELD
- BREAK !
- .
-
- OF ?LAST_FIELD !FROM THE LAST FIELD
- ACTION = 0 ! SET ACTION TO COMPLETE
- RETURN(COPIES) ! AND RETURN TO CALLER
- . . .
-
- !═════════════════════════════════════════════════════════════════════════════
- printr_ready FUNCTION() !** Test printer status prior to trying to use it **
- !---------------------------------------------------------------------
- ! This function was adapted from a public domain routine obtained from
- ! the CLARION bulletin board. This function is being furnished
- ! at no cost.
- !---------------------------------------------------------------------
-
- screen SCREEN WINDOW(9,37),AT(9,23),PRE(scr),HLP('PRNT_ERR'),HUE(7,4)
- ROW(1,1) STRING('╔═{35}╗'),ENH
- ROW(2,1) REPEAT(5);STRING('║<0{35}>║'),ENH .
- ROW(7,1) STRING('╟─{35}╢'),ENH
- ROW(8,1) STRING('║<0{35}>║'),ENH
- ROW(9,1) STRING('╚═{35}╝'),ENH
- ROW(2,8) STRING('PRINTER'),HUE(14,4)
- COL(22) STRING(' '),HUE(30,4)
- COL(23) STRING('NOT'),HUE(14,4)
- COL(27) STRING('READY'),HUE(14,4)
- ROW(4,5) STRING('Select Action:'),ENH
- COL(26) STRING('or'),ENH
- ROW(8,3) STRING('F1'),HUE(14,4)
- COL(6) STRING('Help'),ENH
- COL(26) STRING('ESC'),HUE(14,4)
- COL(30) STRING('Cancel'),ENH
- ROW(1,1) ENTRY,USE(?first_field)
- lpt ROW(2,16) STRING(6),HUE(14,4)
- ROW(6,7) MENU(@S28),USE(?menu),HUE(14,4),SEL(14,4),REQ,IMM
- ROW(4,20) STRING('Retry'),ENH,SEL(1,7) |
- DESC('Attempt to print the report')
- COL(29) STRING('Cancel'),ENH,SEL(1,7) |
- DESC('Cancel the report and quit')
- . .
-
- !************************ Vars for PrnReady *****
- Registers GROUP
- AX SHORT
- BX SHORT
- CX SHORT
- DX SHORT
- SI SHORT
- DI SHORT
- DS SHORT
- ES SHORT
- INT BYTE
- FLAGS SHORT
- END
-
- open_win_sw BYTE
- return_cd BYTE
- lpt_no byte
- !────────────────────────────────────────────────────────────────────────────
- CODE
- return_cd = 1 !* Assume ok
- open_win_sw = 1
-
- case upper(r3m:lpt)
- of 'LPT1'
- lpt_no = 0
-
- of 'LPT2'
- lpt_no = 1
-
- of 'LPT3'
- lpt_no = 2
-
- of 'LPT4'
- lpt_no = 3
-
- else !defualt to lpt1
- lpt_no = 1
- .
-
- loop !main loop
-
- clear(Registers) ! Clear group to zeroes.
- dx = lpt_no ! Select printer: 0 = LPT1, 1 = LPT2, etc
- ax = 0200H ! Printer Status request.
- int = 17h ! ROM-BIOS Printer Services.
- interrupt(Registers) ! Call interrupt handler
-
- if band(ax,2000h) or (not band(ax,8000h)) or |
- band(ax,0100h) or band(ax,0800h)
- if open_win_sw !open window if not already open
- open(screen)
- select(?menu)
- .
- loop
- scr:lpt = '(' & upper(r3m:lpt) & ')'
- accept
- if field() = ?first_field then return(0).
- case choice()
- of 1; open_win_sw = 0; break
- of 2; return_cd = 0; break
- . !case choice
- . !loop
- if not return_cd then break.
- else break
- . !if band
- . !loop main
- return(return_cd)
-
- !═══════════════════════════════════════════════════════════════════════════════
-